(PRIN1(QUOTE "
Transoring of<ENEA>MLISP.;1
 done on 24-JUN-75 14:01:01 ")T)


  (PUT (QUOTE &FILENAME)
       (QUOTE SPECIAL)
       (QUOTE T))

  (PUT (QUOTE &CURFN)
       (QUOTE SPECIAL)
       (QUOTE T))

  (PUT (QUOTE &ECNT)
       (QUOTE SPECIAL)
       (QUOTE T))

  (PUT (QUOTE &RCNT)
       (QUOTE SPECIAL)
       (QUOTE T))

  (PUT (QUOTE &SPECS)
       (QUOTE SPECIAL)
       (QUOTE T))

  (PUT (QUOTE &FNS)
       (QUOTE SPECIAL)
       (QUOTE T))

  (PUT (QUOTE &X&)
       (QUOTE SPECIAL)
       (QUOTE T))

  (PUT (QUOTE &Y&)
       (QUOTE SPECIAL)
       (QUOTE T))

  (PUT (QUOTE SCNVAL)
       (QUOTE SPECIAL)
       (QUOTE T))

  (PUT (QUOTE &SCANVAL)
       (QUOTE SPECIAL)
       (QUOTE T))

  (PUT (QUOTE &SCANTYPE)
       (QUOTE SPECIAL)
       (QUOTE T))

  (PUT (QUOTE &IDTYPE)
       (QUOTE SPECIAL)
       (QUOTE T))

  (PUT (QUOTE &STRTYPE)
       (QUOTE SPECIAL)
       (QUOTE T))

  (PUT (QUOTE &NUMTYPE)
       (QUOTE SPECIAL)
       (QUOTE T))

  (PUT (QUOTE &DELIMTYPE)
       (QUOTE SPECIAL)
       (QUOTE T))

  (PUT (QUOTE BASE)
       (QUOTE SPECIAL)
       (QUOTE T))

  (PUT (QUOTE IBASE)
       (QUOTE SPECIAL)
       (QUOTE T))

  (PUT (QUOTE BLANK)
       (QUOTE SPECIAL)
       (QUOTE T))

  (PUT (QUOTE CR)
       (QUOTE SPECIAL)
       (QUOTE T))

  (PUT (QUOTE VT)
       (QUOTE SPECIAL)
       (QUOTE T))

  (PUT (QUOTE LOC)
       (QUOTE SPECIAL)
       (QUOTE T))

  (PUT (QUOTE CONLIST)
       (QUOTE SPECIAL)
       (QUOTE T))

  (PUT (QUOTE GEN)
       (QUOTE SPECIAL)
       (QUOTE T))

  (PUT (QUOTE REMOB)
       (QUOTE SPECIAL)
       (QUOTE T))

  (PUT (QUOTE KLIST)
       (QUOTE SPECIAL)
       (QUOTE T))

  (PUT (QUOTE BPORG)
       (QUOTE SPECIAL)
       (QUOTE T))

  (PUT (QUOTE LAPORG)
       (QUOTE SPECIAL)
       (QUOTE T))

  (PUT (QUOTE MLISP)
       (QUOTE *FEXPR)
       (QUOTE T))

  (PUT (QUOTE &LAP)
       (QUOTE *FEXPR)
       (QUOTE T))
(DEFINEQ

(MLISP
  [NLAMBDA L
	   (PROG (FILE TIM EX &FILENAME &CURFN &ECNT &RCNT &SPECS &FNS 
		       &X& &Y& &SCANVAL &SCANTYPE)
		 [COND ((NOT (&ISDEVICE (CAR L)))
			(SETQ L (CONS (QUOTE DSK:)
				      L]
		 [COND ((ATOM (SETQ &FILENAME (CADR L)))
			(SETQ FILE &FILENAME))
		       (T (SETQ FILE (CAR &FILENAME]
		 (INC (EVAL (LIST (QUOTE INPUT)
				  (CAR L)
				  &FILENAME))
		      NIL)
		 [COND
		   ((SETQ L (CDDR L))
		    (COND
		      [(GETP (QUOTE PPRINTQ)
			     (QUOTE FSUBR))
		       (SETQ
			 &Y&
			 (EVAL (LIST (QUOTE OUTPUT)
				     (QUOTE DSK:)
				     (CONS FILE (COND
					     ((CAR L)
					      (QUOTE LAP))
					     (T (QUOTE LSP]
		      (T (PRINTSTR (QUOTE "USE MLISPC"))
			 (GO EXIT]
		 (CSYM &M000)
		 [PRINTSTR (PROGN (TERPRI)
				  (PROGN (TERPRI)
					 (QUOTE "*****"]
		 (SETQ TIM (CLOCK 0))
		 [COND ([AND (SETQ EX (MTRANS))
			     (NOT (EQUAL EX (QUOTE (PROG NIL]
			(SETQ &FNS (CONS (PRINTTY (QUOTE RESTART))
					 &FNS))
			(PUT (QUOTE RESTART)
			     (QUOTE EXPR)
			     (LIST (QUOTE LAMBDA)
				   NIL EX]
		 (SETQ TIM (QUOTIENT (DIFFERENCE (CLOCK 0)
						 TIM)
				     1750))
		 (PRINTSTR (PROGN (TERPRI)
				  (QUOTE "*****")))
		 (CSYM G0000)
		 [COND ((NOT (EQ &SCANVAL (QUOTE %.)))
			(&ERROR (QUOTE "END OF PROGRAM NOT A PERIOD"]
		 (PRINTSTR (CAT TIM (QUOTE " SECONDS TRANSLATION TIME"))
			   )
		 (PRINTSTR (CAT &ECNT (QUOTE " ERRORS DETECTED")))
		 (PRINTSTR (CAT &RCNT (QUOTE " FUNCTIONS REDEFINED")))
		 (PROGN (TERPRI)
			(INC NIL T))
		 (COND ((NULL L)
			(COND ((GETP (QUOTE RESTART)
				     (QUOTE EXPR))
			       (RESTART)))
			(GO EXIT)))
		 (SETQ &Y& NIL)
		 [MAPCAR &SPECS (FUNCTION (LAMBDA
					    (&X&)
					    (COND
					      ((NOT (MEMBER &X& &Y&))
					       (PUT &X& (QUOTE SPECIAL)
						    T)
					       (SETQ &Y&
						     (CONS &X& &Y&]
		 (PRINTSTR (QUOTE "SPECIAL DECLARATIONS:"))
		 [PROGN (TERPRI)
			(PROGN (TERPRI)
			       (PRINT (SETQ &SPECS &Y&]
		 [MAPCAR (SETQ &FNS (REVERSE &FNS))
			 (FUNCTION (LAMBDA (&X&)
					   (COND ((GETP &X&
							(QUOTE SPECIAL))
						  (&WARNING
						    (QUOTE 
				   "FUNCTION ALSO DECLARED SPECIAL")
						    &X&]
		 [COND [(CAR L)
			(PRINTSTR (CAT (QUOTE "COMPILING ONTO ")
				       (CAT FILE (QUOTE ".LAP"]
		       (T (PRINTSTR (CAT (QUOTE "PRINTING ONTO ")
					 (CAT FILE (QUOTE ".LSP"]
		 (PROGN (TERPRI)
			(OUTC T (TERPRI NIL)))
		 (SETQ BASE 10)
		 [COND [(CAR L)
			(MAPCAR &FNS
				(FUNCTION
				  (LAMBDA
				    (X)
				    (PROG NIL (COMPILEFUN X)
					  (COND ((REMPROP (PRINTTY
							    X)
							  (QUOTE EXPR))
						 (PUT X (QUOTE *EXPR)
						      T)))
					  (RETURN]
		       (T (PROG NIL (SETQ L (OR (NULL (CDR L))
						(CADR L)))
				(PPRINT (CONS (QUOTE (SPECIAL))
					      &SPECS)
					NIL)
				(PPRINT (CONS (QUOTE (*FEXPR *LEXPR))
					      &FNS)
					NIL)
				(PPRINT (CONS (QUOTE (MACRO))
					      &FNS)
					L)
				(PPRINT (CONS (QUOTE (EXPR FEXPR))
					      &FNS)
					L)
				(RETURN]
		 (SETQ BASE 12)
		 EXIT
		 (OUTC NIL T)
		 (INC NIL T)
		 (RETURN (PROGN (TERPRI)
				(QUOTE ***-END-OF-RUN-***])
)
(DEFINEQ

(MTRANS
  [LAMBDA NIL (PROG (EX)
		    (SETQ &SPECS (SETQ &FNS NIL))
		    (SETQ &ECNT (SETQ &RCNT 0))
		    (SETQ &CURFN (QUOTE TOP-LEVEL))
		    (SETQ &X& T)
		    (SCANSET)
		    (&SCAN)
		    (SETQ EX (&EXPR))
		    (SCANRESET)
		    (RETURN EX])
)
(DEFINEQ

(MEVAL
  [LAMBDA
    NIL
    (PROG
      (MODE &X&)
      (PRIN1 (PROGN (TERPRI)
		    (QUOTE "WELCOME TO MLISP. TYPE `HELP;' FOR HELP.")))
      (SCANSET)
      (SETQ MODE (QUOTE M))
      (PROG
	(&V)
	LOOP
	(COND
	  [T
	    (SETQ
	      &V
	      (PROG
		NIL
		(PRIN1 (PROGN (TERPRI)
			      (PROGN (TERPRI)
				     MODE)))
		[SETQ &X& (COND ((EQ MODE (QUOTE M))
				 (MTRANS))
				(T (READ]
		[COND
		  ((EQ &X& (QUOTE LISP))
		   (SCANRESET)
		   (SETQ MODE (QUOTE L)))
		  ((EQ &X& (QUOTE MLISP))
		   (SCANSET)
		   (SETQ MODE (QUOTE M)))
		  ((EQ &X& (QUOTE HELP))
		   (PROG NIL (EVAL (QUOTE (INC (INPUT HELP SYS:
						      (HELP . MLI))
					       NIL)))
			 (PRINTSTR (READ))
			 (INC NIL T)
			 (RETURN)))
		  ((EQ MODE (QUOTE M))
		   (SCANRESET)
		   (ERSETQ (PRINT (EVAL &X&)))
		   (SCANSET))
		  (T (ERSETQ (PRINT (EVAL &X&]
		(RETURN]
	  (T (RETURN &V)))
	(GO LOOP))
      (RETURN])
)
(DEFINEQ

(&EXPR
  [LAMBDA NIL (&HIER 0 (&SIMPEX])
)
(DEFINEQ

(&HIER
  [LAMBDA (RBP EX)
	  (COND ((OR (EQ &SCANTYPE &NUMTYPE)
		     (EQ &SCANTYPE &STRTYPE))
		 (&ERROR (QUOTE "ILLEGAL INFIX OPERATOR")))
		((GREATERP RBP (&BINDINGPOWER &SCANVAL (QUOTE &LEFT)))
		 EX)
		(T (&HIER1 RBP EX (&BINDINGPOWER &SCANVAL (QUOTE &RIGHT]
)
)
(DEFINEQ

(&HIER1
  [LAMBDA (RBP EX RBP1)
	  (&HIER RBP (&TINFIX (&ADVANCE &SCANVAL)
			      (&NEXTDELIM (QUOTE ⊗))
			      EX
			      (&HIER RBP1 (&SIMPEX])
)
(DEFINEQ

(&SIMPEX
  [LAMBDA NIL ([LAMBDA (EX)
		       (COND [(&NEXTDELIM (QUOTE %[))
			      (LIST (QUOTE &INDEX)
				    EX
				    (CONS (QUOTE LIST)
					  (&ARGS (QUOTE %])
						 (QUOTE 
					 "ILLEGAL INDEX EXPRESSION"]
			     (T EX]
	   (COND ((&ID)
		  (&TFNCALL (&ADVANCE &SCANVAL)))
		 ((EQ &SCANTYPE &NUMTYPE)
		  (&ADVANCE &SCANVAL))
		 [(GETP &SCANVAL (QUOTE &RESWORD))
		  (COND [(&NEXT (QUOTE BEGIN))
			 (CONS (QUOTE PROG)
			       (CONS (&TDECL NIL)
				     (&EXPRLIST]
			[(&NEXT (QUOTE IF))
			 (CONS (QUOTE COND)
			       (&TCOND (&EXPR]
			((&NEXT (QUOTE FOR))
			 (&TFOR))
			((&NEXT (QUOTE WHILE))
			 (&TWHILE (&QEXPR)))
			((&NEXT (QUOTE DO))
			 (&TDO (QUOTE (QUOTE PROG2))
			       (&QEXPR)
			       (QUOTE DO)))
			((&NEXT (QUOTE COLLECT))
			 (&TDO (QUOTE (QUOTE APPEND))
			       (&QEXPR)
			       (QUOTE COLLECT)))
			((&NEXT (QUOTE LAMBDA))
			 (&TLAMBDA T))
			((&NEXT (QUOTE DEFINE))
			 (&TDEFINE))
			((&NEXT (QUOTE COMMENT))
			 (&SEMISKIP)
			 (&SCAN)
			 (&SIMPEX))
			((GETP &SCANVAL (QUOTE &FNTYPE))
			 (&TFN (&ADVANCE &SCANVAL)
			       (&ADVANCE &SCANVAL)))
			((EQ &SCANVAL (QUOTE OCTAL))
			 (&OCTALNUM))
			((EQ &SCANVAL (QUOTE INLINE))
			 (&INLINECODE))
			(T (&ERROR (QUOTE 
		    "ILLEGAL RESERVED WORD BEGINNING AN EXPRESSION"]
		 [(GETP &SCANVAL (QUOTE &PREFIX))
		  (&TPREFIX (&ADVANCE &SCANVAL)
			    (&NEXTDELIM (QUOTE ⊗]
		 [(EQ &SCANVAL (QUOTE '))
		  (&ADVANCE (LIST (QUOTE QUOTE)
				  (SREAD]
		 ((&NEXTDELIM (QUOTE %())
		  (&TPAREN (&EXPR)))
		 [(&NEXTDELIM (QUOTE <))
		  (CONS (QUOTE LIST)
			(&ARGS (QUOTE >)
			       (QUOTE 
			      "ILLEGAL EXPRESSION IN LIST BRACKETS"]
		 ((EQ &SCANTYPE &STRTYPE)
		  (&ADVANCE (LIST (QUOTE QUOTE)
				  &SCANVAL)))
		 (T (&ERROR (QUOTE 
		     "ILLEGAL SYMBOL BEGINNING A SIMPLE EXPRESSION"])
)
(DEFINEQ

(&TPREFIX
  [LAMBDA (FN VOP)
	  (&TP1 FN VOP (&HIER (&BINDINGPOWER FN (QUOTE &RIGHT))
			      (&SIMPEX])
)
(DEFINEQ

(&TP1
  [LAMBDA (FN VOP EX)
	  (COND ((EQ FN (QUOTE PLUS))
		 EX)
		((AND (EQ FN (QUOTE DIFFERENCE))
		      (SETQ FN (QUOTE MINUS))
		      (NUMBERP EX)
		      (NOT VOP))
		 (MINUS EX))
		(VOP (LIST (QUOTE &VECTOR)
			   T
			   (LIST (QUOTE QUOTE)
				 FN)
			   EX NIL))
		(T (LIST FN EX])
)
(DEFINEQ

(&TINFIX
  [LAMBDA (FN VOP X Y)
	  (COND [(EQ FN (QUOTE ←))
		 (COND (VOP (LIST (QUOTE &DECOMPOSE)
				  X Y))
		       ((ATOM X)
			(LIST (QUOTE SETQ)
			      X Y))
		       ((EQ (CAR X)
			    (QUOTE &INDEX))
			(&TREPLACE (CADR X)
				   (CADDR X)
				   Y
				   (GENSYM)))
		       ((ATOM (CAR X))
			(LIST (QUOTE STORE)
			      X Y))
		       (T (&ERROR (CAT (QUOTE "ILLEGAL ASSIGNMENT TO  ")
				       X]
		(VOP (LIST (QUOTE &VECTOR)
			   NIL
			   (LIST (QUOTE QUOTE)
				 FN)
			   X Y))
		((AND (EQ Y 1)
		      (EQ FN (QUOTE PLUS)))
		 (LIST (QUOTE ADD1)
		       X))
		((AND (EQ Y 1)
		      (EQ FN (QUOTE DIFFERENCE)))
		 (LIST (QUOTE SUB1)
		       X))
		((AND (GETP FN (QUOTE &ASSOC))
		      (NOT (ATOM X))
		      (EQ FN (CAR X)))
		 (APPEND X (LIST Y)))
		(T (LIST FN X Y])
)
(DEFINEQ

(&TDECL
  [LAMBDA (L)
	  (COND [(&NEXT (QUOTE NEW))
		 (&TDECL (APPEND L (&VARS (QUOTE ;)
					  NIL NIL]
		((&NEXT (QUOTE SPECIAL))
		 (&TDECL (PROGN (&VARS (QUOTE ;)
				       T NIL)
				L)))
		(T L])
)
(DEFINEQ

(&EXPRLIST
  [LAMBDA NIL (PROG (EX L X)
		    LOOP
		    [COND ((SETQ EX (&EXPR))
			   (SETQ L (CONS EX L]
		    (SETQ X (&NEXTDELIM (QUOTE ;)))
		    [COND ((&NEXT (QUOTE END))
			   (RETURN (REVERSE L)))
			  (X (GO LOOP))
			  (T (&ERROR (QUOTE 
			       "MISSING SEMICOLON AFTER EXPRESSION"]
		    (RETURN])
)
(DEFINEQ

(&TCOND
  [LAMBDA (EX)
	  (COND [(&NEXT (QUOTE THEN))
		 (&TC1 (CONS EX (&TALSO (&EXPR]
		(T (&ERROR (QUOTE "ILLEGAL EXPRESSION AFTER IF"])
)
(DEFINEQ

(&TC1
  [LAMBDA (L)
	  (COND [(&NEXT (QUOTE ELSE))
		 (COND [(&NEXT (QUOTE IF))
			(CONS L (&TCOND (&EXPR]
		       (T (LIST L (CONS T (&TALSO (&EXPR]
		(T (LIST L])
)
(DEFINEQ

(&TALSO
  [LAMBDA (EX)
	  (COND [(&NEXT (QUOTE ALSO))
		 (CONS EX (&TALSO (&EXPR]
		(T (LIST EX])
)
(DEFINEQ

(&TFOR
  [LAMBDA NIL (LIST (QUOTE &FOR)
		    (LIST (QUOTE QUOTE)
			  (&FORCLAUSE))
		    [LIST (QUOTE QUOTE)
			  (COND ((&NEXT (QUOTE DO))
				 (QUOTE PROG2))
				((&NEXT (QUOTE COLLECT))
				 (QUOTE APPEND))
				((&NEXTDELIM (QUOTE ;))
				 (&ADVANCE &SCANVAL))
				(T (&ERROR (QUOTE 
			    "EXPECTED DO, COLLECT OR ; IN FOR-LOOP"]
		    (&QEXPR)
		    (COND ((&NEXT (QUOTE UNTIL))
			   (&QEXPR))
			  (T (QUOTE (QUOTE NIL])
)
(DEFINEQ

(&FORCLAUSE
  [LAMBDA
    NIL
    (CONS [CONS (COND ((&NEXT (QUOTE NEW))
		       (QUOTE NEW))
		      (T (QUOTE OLD)))
		(CONS [COND ((&ID)
			     (&ADVANCE &SCANVAL))
			    (T (&ERROR (QUOTE 
			       "NON-IDENTIFIER OR PREFIX AFTER FOR"]
		      (COND
			((&NEXT (QUOTE IN))
			 (LIST (QUOTE IN)
			       (&EXPR)))
			((&NEXT (QUOTE ON))
			 (LIST (QUOTE ON)
			       (&EXPR)))
			[(&NEXTDELIM (QUOTE ←))
			 (LIST (QUOTE ←)
			       (LIST (QUOTE &RANGE)
				     (&EXPR)
				     [COND ((&NEXT (QUOTE TO))
					    (&EXPR))
					   (T (&ERROR (QUOTE 
				  "ILLEGAL LOWER LIMIT IN FOR-LOOP"]
				     (COND ((&NEXT (QUOTE BY))
					    (&EXPR))
					   (T 1]
			(T (&ERROR (QUOTE 
	  "MISSING IN, ON, OR ← AFTER CONTROL VARIABLE IN FOR-LOOP"]
	  (COND ((&NEXT (QUOTE FOR))
		 (&FORCLAUSE))
		(T NIL])
)
(DEFINEQ

(&TDO
  [LAMBDA (FN EX X)
	  (COND ((&NEXT (QUOTE UNTIL))
		 (LIST (QUOTE &DO)
		       FN EX (&QEXPR)))
		(T (&ERROR (CAT (QUOTE "EXPECTED UNTIL IN ")
				(CAT X (QUOTE "-UNTIL EXPRESSION"])
)
(DEFINEQ

(&TWHILE
  [LAMBDA (EX)
	  (COND ((&NEXT (QUOTE DO))
		 (LIST (QUOTE &WHILE)
		       (QUOTE (QUOTE PROG2))
		       EX
		       (&QEXPR)))
		((&NEXT (QUOTE COLLECT))
		 (LIST (QUOTE &WHILE)
		       (QUOTE (QUOTE APPEND))
		       EX
		       (&QEXPR)))
		(T (&ERROR (QUOTE 
		       "EXPECTED DO OR COLLECT IN WHILE EXPRESSION"])
)
(DEFINEQ

(&TDEFINE
  [LAMBDA
    NIL
    (PROG (&V)
	  LOOP
	  (SETQ
	    &V
	    (PROG (VAL TYP)
		  [COND ((AND (NOT (EQ (SETQ TYP &SCANTYPE)
				       &IDTYPE))
			      (NOT (EQ &SCANTYPE &DELIMTYPE)))
			 (&ERROR (QUOTE "ILLEGAL SYMBOL BEING DEFINED"]
		  (SETQ VAL (&ADVANCE &SCANVAL))
		  (COND ((&NEXT (QUOTE PREFIX))
			 (&MAKPREFIX VAL)))
		  (COND
		    ([OR [AND (EQ &SCANTYPE &IDTYPE)
			      (NOT (EQ &SCANVAL (QUOTE DIFFERENCE]
			 (AND (EQ &SCANTYPE &DELIMTYPE)
			      (NOT (MEMBER &SCANVAL
					   (QUOTE (, ;]
		     (PUT &SCANVAL (QUOTE &TRANSTYPE)
			  TYP)
		     (PUT (&ADVANCE &SCANVAL)
			  (QUOTE &TRANS)
			  VAL)))
		  [COND ((&NUMB VAL (QUOTE &LEFT))
			 (OR (&NUMB VAL (QUOTE &RIGHT))
			     (&ERROR (QUOTE 
				      "MISSING RIGHT BINDING POWER"]
		  (RETURN)))
	  (COND ((NOT (&NEXTDELIM (QUOTE ,)))
		 (RETURN &V))
		(T (GO LOOP])
)
(DEFINEQ

(&NUMB
  [LAMBDA (VAL IND)
	  (COND ((EQ &SCANTYPE &NUMTYPE)
		 (&ADVANCE (PUT VAL IND &SCANVAL)))
		((&NEXT (QUOTE DIFFERENCE))
		 (COND [(EQ &SCANTYPE &NUMTYPE)
			(&ADVANCE (PUT VAL IND (MINUS &SCANVAL]
		       (T (&ERROR (QUOTE "ILLEGAL BINDING POWER"])
)
(DEFINEQ

(&TFN
  [LAMBDA (IND &CURFN)
	  (PROG (L)
		(&FNCHECK &CURFN)
		(PUT &CURFN IND (SETQ L (&TLAMBDA NIL)))
		(COND ((EQ IND (QUOTE EXPR))
		       (AND (EQ (LENGTH (CADR L))
				1)
			    (&MAKPREFIX &CURFN)))
		      ((EQ IND (QUOTE FEXPR))
		       (PUT &CURFN (QUOTE *FEXPR)
			    T))
		      [(EQ IND (QUOTE LEXPR))
		       (COND ((EQ (LENGTH (CADR L))
				  1)
			      (PUT &CURFN (QUOTE EXPR)
				   (LIST (QUOTE LAMBDA)
					 (CAADR L)
					 (CADDR L)))
			      (PUT &CURFN (QUOTE *LEXPR)
				   T))
			     (T (&ERROR (CAT (QUOTE 
		      "LEXPRS MUST HAVE EXACTLY ONE ARGUMENT, NOT ")
					     (CADR L]
		      (T NIL))
		(SETQ &FNS (CONS &CURFN &FNS))
		(RETURN])
)
(DEFINEQ

(&FNCHECK
  [LAMBDA (X)
	  (COND ((GETLIS X (QUOTE (EXPR FEXPR SUBR FSUBR MACRO)))
		 (SETQ &RCNT (ADD1 &RCNT))
		 (&WARNING (QUOTE "FUNCTION REDEFINED")
			   X))
		(T (PRINTTY X])
)
(DEFINEQ

(&MAKPREFIX
  [LAMBDA (FN)
	  (PROG NIL (OR (GETP FN (QUOTE &RIGHT))
			(PUT FN (QUOTE &RIGHT)
			     1750))
		(OR (GETP FN (QUOTE &LEFT))
		    (PUT FN (QUOTE &LEFT)
			 -1))
		(PUT FN (QUOTE &PREFIX)
		     T)
		(RETURN])
)
(DEFINEQ

(&TLAMBDA
  [LAMBDA (ALLOW)
	  (COND ((&NEXTDELIM (QUOTE %())
		 (&TL1 (&VARS (QUOTE %))
			      (&NEXT (QUOTE SPECIAL))
			      T)
		       ALLOW))
		(T (&ERROR (QUOTE "'(' NEEDED FOR LAMBDA VARIABLES"])
)
(DEFINEQ

(&TL1
  [LAMBDA (L ALLOW)
	  (COND ((&NEXTDELIM (QUOTE ;))
		 (&TL2 (LIST (QUOTE LAMBDA)
			     L
			     (&EXPR))
		       ALLOW))
		(T (&ERROR (QUOTE "';' NEEDED AFTER LAMBDA VARIABLES"])
)
(DEFINEQ

(&TL2
  [LAMBDA (EX ALLOW)
	  (COND [(AND ALLOW (&NEXTDELIM (QUOTE ;)))
		 (COND [(&NEXTDELIM (QUOTE %())
			(CONS EX (&ARGS (QUOTE %))
					(QUOTE 
					  "ILLEGAL LAMBDA ARGUMENT"]
		       (T (&ERROR (QUOTE 
				  "'(' NEEDED FOR LAMBDA ARGUMENTS"]
		(T EX])
)
(DEFINEQ

(&VARS
  [LAMBDA (TERMIN ISSPEC ALLOW)
	  (COND ((&NEXTDELIM TERMIN)
		 NIL)
		(T (CONS (&TID ISSPEC)
			 (&VAR1 TERMIN ISSPEC ALLOW])
)
(DEFINEQ

(&VAR1
  [LAMBDA (TERMIN ISSPEC ALLOW)
	  (COND ((&NEXTDELIM (QUOTE ,))
		 (CONS (&TID (OR (AND ALLOW (&NEXT (QUOTE SPECIAL)))
				 (AND (NOT ALLOW)
				      ISSPEC)))
		       (&VAR1 TERMIN ISSPEC ALLOW)))
		((&NEXTDELIM TERMIN)
		 NIL)
		(T (&ERROR (QUOTE "ILLEGAL PROG OR LAMBDA VARIABLE"])
)
(DEFINEQ

(&ARGS
  [LAMBDA (TERMIN MSG)
	  (COND ((&NEXTDELIM TERMIN)
		 NIL)
		(T (CONS (&EXPR)
			 (&ARG1 TERMIN MSG])
)
(DEFINEQ

(&ARG1
  [LAMBDA (TERMIN MSG)
	  (COND ((&NEXTDELIM (QUOTE ,))
		 (CONS (&EXPR)
		       (&ARG1 TERMIN MSG)))
		((&NEXTDELIM TERMIN)
		 NIL)
		(T (&ERROR MSG])
)
(DEFINEQ

(&TID
  [LAMBDA (ISSPEC)
	  (COND ((&ID)
		 (AND ISSPEC (SETQ &SPECS (CONS &SCANVAL &SPECS)))
		 (&ADVANCE &SCANVAL))
		(T (&ERROR (QUOTE 
	    "NON-IDENTIFIER OR PREFIX USED IN FORMAL VARIABLE LIST"])
)
(DEFINEQ

(&TFNCALL
  [LAMBDA (X)
	  (COND [(&NEXTDELIM (QUOTE %())
		 (CONS X (&ARGS (QUOTE %))
				(QUOTE "ILLEGAL ARGUMENT"]
		(T X])
)
(DEFINEQ

(&TREPLACE
  [LAMBDA (X L Y G)
	  (LIST (QUOTE PROG2)
		(LIST (QUOTE SETQ)
		      X
		      (LIST (QUOTE &REPLACE)
			    X L (LIST (QUOTE SETQ)
				      G Y)))
		G])
)
(DEFINEQ

(&TPAREN
  [LAMBDA (EX)
	  (COND ((&NEXTDELIM (QUOTE %)))
		 EX)
		(T (&ERROR (QUOTE "ILLEGAL PARENTHESIZED EXPRESSION"])
)
(DEFINEQ

(&OCTALNUM
  [LAMBDA NIL (PROG (IBASE)
		    (SETQ IBASE 10)
		    (&SCAN)
		    [COND ((EQ &SCANTYPE &NUMTYPE)
			   (RETURN (&ADVANCE &SCANVAL)))
			  (T (&ERROR (QUOTE 
		     "RESERVED WORD OCTAL NOT FOLLOWED BY A NUMBER"]
		    (RETURN])
)
(DEFINEQ

(&INLINECODE
  [LAMBDA NIL (PROG (BASE IBASE)
		    (SETQ BASE (SETQ IBASE 10))
		    [COND ([OR (ATOM (SETQ &SCANVAL (SREAD)))
			       (NOT (EQ (CAR &SCANVAL)
					(QUOTE LAP]
			   (&ERROR (QUOTE 
	      "INLINE CODE DOES NOT BEGIN WITH: (LAP <NAME> <IND>)"]
		    (&FNCHECK (CADR &SCANVAL))
		    [COND (&Y& (PROG NIL (OUTC T NIL)
				     (PRINT &SCANVAL)
				     L
				     (COND ((PRINT (READ))
					    (GO L))
					   (T (OUTC (TERPRI NIL)
						    NIL)))
				     (RETURN)))
			  (T (EVAL (CONS (QUOTE &LAP)
					 (CDR &SCANVAL]
		    (&SCAN)
		    (RETURN])
)
(DEFINEQ

(&ERROR
  [LAMBDA (MSG)
	  (PROG (PAGE LINE IFILE OFILE X)
		(SETQ &ECNT (ADD1 &ECNT))
		(SETQ PAGE (CAR (PGLINE)))
		(SETQ LINE (CDR (PGLINE)))
		(SETQ OFILE (OUTC NIL NIL))
		(TERPRI NIL)
		(PRINTSTR (CAT (QUOTE "*** ERROR IN ")
			       &CURFN))
		(PRINTSTR (CAT (QUOTE "*** ")
			       MSG))
		(PRINTSTR (CAT (QUOTE "*** CURRENT SYMBOL IS ")
			       &SCANVAL))
		(COND ((NULL (SETQ IFILE (INC NIL NIL)))
		       (GO MORE)))
		[PRINTSTR (CAT (QUOTE "*** LINE NUMBER ")
			       (CAT LINE (CAT (QUOTE %%)
					      PAGE]
		(PRINTSTR (QUOTE 
		      "*** TYPE E TO EDIT YOUR FILE, C TO CONTINUE"))
		LOOP
		(COND ((EQ (SETQ X (SREAD))
			   (QUOTE E))
		       (AND (EQ (READCH)
				CR)
			    (READCH))
		       (PRINTSTR VT)
		       (SWAP &FILENAME PAGE LINE))
		      ((EQ X (QUOTE C))
		       (GO MORE))
		      (T (PRINTSTR (CAT (QUOTE "TYPE E OR C, NOT  ")
					X))
			 (GO LOOP)))
		MORE
		(PRINTSTR (QUOTE "*** SKIPPING TO NEXT SEMICOLON"))
		(INC IFILE NIL)
		(OUTC OFILE NIL)
		(&SEMISKIP)
		(RETURN])
)
(DEFINEQ

(&WARNING
  [LAMBDA (MSG X)
	  (PROG (OFILE)
		(SETQ OFILE (OUTC NIL NIL))
		(PRIN1 (PROGN (TERPRI)
			      (QUOTE "*** WARNING ***, ")))
		(PRIN1 MSG)
		(PRIN1 (QUOTE ": "))
		(PRINTSTR X)
		(OUTC OFILE NIL)
		(RETURN X])
)
(DEFINEQ

(&SEMISKIP
  [LAMBDA NIL (PROG (&V)
		    LOOP
		    (COND ((NOT (AND (EQ &SCANVAL (QUOTE ;))
				     (EQ &SCANTYPE &DELIMTYPE)))
			   (SETQ &V (&SCAN)))
			  (T (RETURN &V)))
		    (GO LOOP])
)
(DEFINEQ

(&SCAN
  [LAMBDA NIL (COND ((EQ (SETQ &SCANTYPE (SCAN))
			 &IDTYPE)
		     (&SCAN1 (INTERN SCNVAL)))
		    [(EQ &SCANTYPE &DELIMTYPE)
		     (&SCAN1 (INTERN (CHARACTER SCNVAL]
		    (T (SETQ &SCANVAL SCNVAL])
)
(DEFINEQ

(&SCAN1
  [LAMBDA (X)
	  (COND [(AND (GETP X (QUOTE &TRANS))
		      &X&)
		 (SETQ &SCANTYPE (GETP X (QUOTE &TRANSTYPE)))
		 (SETQ &SCANVAL (GETP X (QUOTE &TRANS]
		(T (SETQ &SCANVAL X])
)
(DEFINEQ

(&NEXT
  [LAMBDA (X)
	  (COND ((EQ &SCANVAL X)
		 (&ADVANCE T])
)
(DEFINEQ

(&NEXTDELIM
  [LAMBDA (X)
	  (COND ((AND (EQ &SCANVAL X)
		      (EQ &SCANTYPE &DELIMTYPE))
		 (&ADVANCE T])
)
(DEFINEQ

(&ADVANCE
  [LAMBDA (X)
	  (PROGN (&SCAN)
		 X])
)
(DEFINEQ

(&ID
  [LAMBDA NIL (AND (EQ &SCANTYPE &IDTYPE)
		   (NOT (OR (GETP &SCANVAL (QUOTE &RESWORD))
			    (GETP &SCANVAL (QUOTE &PREFIX])
)
(DEFINEQ

(&BINDINGPOWER
  [LAMBDA (X IND)
	  (COND ((SETQ X (GETP X IND))
		 X)
		(T (GETP (QUOTE &DEFAULT)
			 IND])
)
(DEFINEQ

(&QEXPR
  [LAMBDA NIL (LIST (QUOTE QUOTE)
		    (&EXPR])
)
(DEFINEQ

(&ISDEVICE
  [LAMBDA (X)
	  (OR (AND (ATOM X)
		   (EQ (CAR (FLAST (UNPACK X)))
		       (QUOTE :)))
	      (AND (NOT (ATOM X))
		   (NOT (ATOM (CDR X])
)
(DEFINEQ

(&LAP
  [NLAMBDA X (PROG (LOC CONLIST GEN REMOB)
		   (SETQ GEN (GENSYM))
		   (SETQ CONLIST (LIST NIL))
		   (SETQ LOC BPORG)
		   LOOP
		   (COND ((NULL (SETQ &SCANVAL (SREAD)))
			  (GO EXIT))
			 ((ATOM &SCANVAL)
			  (GO A))
			 (T (GO I)))
		   A
		   (DEFSYM &SCANVAL LOC)
		   (GO LOOP)
		   I
		   (CLOSER LOC (GWD &SCANVAL))
		   (&BPCHECK)
		   (GO LOOP)
		   EXIT
		   (DEFSYM GEN LOC)
		   [MAPCAR (CDR CONLIST)
			   (FUNCTION (LAMBDA
				       (Y)
				       (PROG NIL
					     (SETQ KLIST
						   (CONS (CONS Y LOC)
							 KLIST))
					     (CLOSER LOC (GWD Y))
					     (&BPCHECK)
					     (RETURN]
		   (PUT (CAR X)
			(CADR X)
			(VAG BPORG))
		   (SETQ BPORG LOC)
		   [MAPCAR REMOB (FUNCTION
			     (LAMBDA (Y)
				     (COND
				       ((AND (REMPROP Y (QUOTE SYM))
					     (GETP Y (QUOTE UNDEF)))
					(&ERROR (CAT (QUOTE 
			    "UNDEFINED LABEL USED IN INLINE CODE: ")
						     Y]
		   (RETURN])
)
(DEFINEQ

(&BPCHECK
  [LAMBDA NIL (COND ((NOT (LESSP (SETQ LOC (ADD1 LOC))
				 LAPORG))
		     (&ERROR (QUOTE "BINARY PROGRAM SPACE EXCEEDED"])
)
STOP